home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FINDREPL.SWG / 0011_SEARCH.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  13KB  |  293 lines
  1. Program search;
  2. {$A+,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}
  3. {$M 16384,0,655360}
  4.  
  5.  
  6.  { Copyright 1990 Trevor J Carlsen Version 1.05  24-07-90                    }
  7.  { This Program may be used and distributed as if it was in the Public Domain}
  8.  { With the following exceptions:                                            }
  9.  {    1.  if you alter it in any way, the copyright notice must not be       }
  10.  {        changed.                                                           }
  11.  {    2.  if you use code excerpts in your own Programs, due credit must be  }
  12.  {        given, along With a copyright notice -                             }
  13.  {        "Parts Copyright 1990 Trevor J Carlsen"                            }
  14.  {    3.  No Charge may be made For any Program using code from this Program.} 
  15.  
  16.  { SEARCH will scan a File or group of Files and report on all occurrences   }
  17.  { of a particular String or group of Characters. if found the search String }
  18.  { will be displayed along With the 79 Characters preceding it and the 79    }
  19.  { Characters following the line it is in.  Wild cards may be used in the    }
  20.  { Filenames to be searched.                                                 }
  21.  
  22.  { if you find this Program useful here is the author's contact address -    }          
  23.          
  24.  {      Trevor J Carlsen                                                     }          
  25.  {      PO Box 568                                                           }          
  26.  {      Port Hedland Western Australia 6721                                  }          
  27.  {      Voice 61 [0]91 72 2026                                               }          
  28.  {      Data  61 [0]91 72 2569                                               }          
  29.  
  30.  
  31.  
  32. Uses
  33.   Dos,
  34.   tpString,  { Turbo Power's String handling library.  Procedures and        }
  35.              { Functions used from this Unit are -                           }
  36.              {       BMSearch       THESE ARE in THE SOURCE\MISC DIRECtoRY   }
  37.              {       BMSearchUC                                              }
  38.              {       BMMakeTable                                             }
  39.              {       StUpCase                                                }
  40.   tctimer;   { A little timing routine - not needed if lines (**) removed.   }
  41.   
  42. Const
  43.   bufflen     = 65000;  { Do not increase this buffer size . Ok to decrease. }
  44.   searchlen   = bufflen;
  45.   copyright1  = 'SEARCH - version 1.05 Copyright 1990 Trevor Carlsen';
  46.   copyright2  = 'All rights reserved.';
  47.  
  48. Type
  49.   str79       = String[79];
  50.   bufferType  = Array[0..bufflen] of Byte;
  51.   buffptr     = ^bufferType;
  52.  
  53. Const
  54.   space       = #32;
  55.   quote       = #34;
  56.   comma       = #44;
  57.   CaseSensitive : Boolean = True;       { default is a Case sensitive search }
  58. Var
  59.   table       : BTable;                           { Boyer-Moore search table }
  60.   buffer      : buffptr;                             { Pointer to new buffer }
  61.   f           : File;
  62.   DisplayStr  : Array[0..3] of str79;
  63.   Filename,
  64.   SrchStr     : String;
  65.   Slen        : Byte Absolute SrchStr;
  66.   
  67. Procedure Asc2Str(Var s, ns; max: Byte);
  68.  
  69.   { Converts an Array of asciiz Characters to a turbo String                 }
  70.   { For speed the Variable st is  effectively global and it is thereFore     }
  71.   { vitally important that max is no larger than the ns unTyped parameter    }
  72.   { Failure to ensure this can result in unpredictable Program behaviour     }
  73.   
  74.   Var stArray : Array[0..255] of Byte Absolute s;
  75.       st      : String Absolute ns;
  76.       len     : Byte Absolute st;
  77.       
  78.   begin
  79.     move(stArray[0],st[1],max);
  80.     len := max;
  81.   end; { Asc2Str }
  82.  
  83. Procedure ReportError(e : Byte);
  84.   { Displays a simple instruction screen in the event of insufficient        }
  85.   { parameters or certain other errors                                       }
  86.   begin
  87.     Writeln('SYNTAX:');
  88.     Writeln('SEARCH [-c] [path]Filename searchstr');
  89.     Writeln(' eg:  SEARCH c:\comm\telix\salt.doc "color"');
  90.     Writeln(' or');
  91.     Writeln('      SEARCH c:\comm\telix\salt.doc 13,10,13,10,13,10,13,10');
  92.     Writeln(' or');
  93.     Writeln('      SEARCH -c c:\*.* "MicroSoft"');
  94.     Writeln;
  95.     Writeln('if the -c option is used then a Case insensitive search is used.');
  96.     Writeln('When used the -c option must be the first parameter.');
  97.     halt(e);
  98.   end; { ReportError }
  99.  
  100. Procedure ParseCommandLine;
  101.   { This Procedure is Really the key to everything as it parses the command  }
  102.   { line to determine what the String being searched For is.  Because the    }
  103.   { wanted String can be entered in literal Form or in ascii codes this will }
  104.   { disect and determine the method used.                                    }
  105.   
  106.   Var
  107.     parstr      : String;                        { contains the command line }
  108.     len         : Byte Absolute parstr;{ will contain the length of cmd line }
  109.     cpos, qpos,
  110.     spos, chval : Byte;
  111.     error       : Integer;
  112.     
  113.   begin { ParseCommandLine}
  114.     parstr    := String(ptr(PrefixSeg,$80)^);         { Get the command line }
  115.     if parstr[1] = space then
  116.       delete(parstr,1,1);  { if the first Character is a space get rid of it }
  117.     spos      := pos(space,parstr);                   { find the first space }
  118.     if spos    = 0 then                   { No spaces which must be an error }
  119.       ReportError(1);   
  120.     
  121.     Filename  := StUpCase(copy(parstr,1,spos-1));  { Filename used as a temp }
  122.     if pos('-C',Filename) = 1 then begin  { Case insensitive search required }
  123.       CaseSensitive := False;
  124.       delete(parstr,1,spos);                   { Get rid of the used portion }
  125.     end; { if pos('-C' }
  126.     spos      := pos(space,parstr);                        { find next space }
  127.     if spos    = 0 then                   { No spaces which must be an error }
  128.       ReportError(1);                     
  129.     Filename  := StUpCase(copy(parstr,1,spos-1));        { Get the File mask }
  130.     delete(parstr,1,spos);                     { Get rid of the used portion }
  131.     
  132.     qpos      := pos(quote,parstr);          { look For the first quote Char }
  133.     if qpos   <> 0 then begin    { quote Char found - so must be quoted Text }
  134.       if parstr[1] <> quote then ReportError(2);  { first Char must be quote }
  135.       delete(parstr,1,1);                       { get rid of the first quote }
  136.       qpos      := pos(quote,parstr);              { and find the next quote }
  137.       if qpos = 0 then ReportError(3);  { no more quotes - so it is an error }
  138.       SrchStr   := copy(parstr,1,qpos-1);        { search String now defined }
  139.     end  { if qpos <> 0 }
  140.     
  141.     else begin                                   { must be using ascii codes }
  142.       Slen      := 0;     
  143.       cpos      := pos(comma,parstr);                     { find first comma }
  144.       if cpos = 0 then cpos := succ(len);{ No comma - so only one ascii code }
  145.       Repeat                                      { create the search String }
  146.         val(copy(parstr,1,pred(cpos)),chval,error);
  147.         if error <> 0 then ReportError(7);   { there is an error so bomb out }
  148.         inc(Slen);
  149.         SrchStr[Slen] := Char(chval);        { add Char to the search String }
  150.         delete(parstr,1,cpos);           { get rid of used portion of parstr }
  151.         cpos  := pos(comma,parstr);                    { find the next comma }
  152.         if cpos = 0 then cpos := succ(len);    { no more commas so last Char }
  153.       Until len = 0;              { Until whole of command line is processed }
  154.     end; { else}
  155.     
  156.     if not CaseSensitive then       { change the Search String to upper Case }
  157.       SrchStr := StUpCase(SrchStr);
  158.   end; { ParseCommandLine }
  159.  
  160. Function OpenFile(ofn : String): Boolean;  { open a File For BlockRead/Write }
  161.   Var
  162.     error : Word;
  163.   begin { OpenFile}
  164.     assign(f,ofn);
  165.     {$I-} reset(f,1); {$I+}
  166.     error := Ioresult;
  167.     if error <> 0 then
  168.       Writeln('Cannot open ',ofn);
  169.     OpenFile := error = 0;
  170.   end; { OpenFile }
  171.  
  172. Procedure CloseFile;
  173.   begin
  174.     {$I-}
  175.     Close(f);
  176.     if Ioresult <> 0 then;    { don't worry too much if an error occurs here }
  177.     {$I+}
  178.   end; { CloseFile }
  179.  
  180. Procedure SearchFile(Var Filename: String);
  181.   { Reads a File into the buffer and then searches that buffer For the wanted}
  182.   { String or Characters.                                                    }
  183.   Var
  184.     x,y,
  185.     count,
  186.     result,
  187.     bufferpos   : Word;
  188.     abspos      : LongInt;
  189.     finished    : Boolean;
  190.     
  191.   begin  { SearchFile}
  192.     BMMakeTable(SrchStr,table);          { Create a Boyer-Moore search table }
  193.     new(buffer);                     { make room on the heap For the buffers }
  194.     {$I-} BlockRead(f,buffer^,searchlen,result); {$I+}  { Fill buffer buffer }
  195.     if Ioresult <> 0 then begin      { error occurred While reading the File }
  196.       CloseFile;
  197.       ReportError(11);
  198.     end; { if Ioresult }
  199.     abspos       := 0;        { Initialise the Absolute File position marker }
  200.     Repeat
  201.       bufferpos      := 0;               { position marker in current buffer }
  202.       count          := 0;               { offset from search starting point }
  203.       finished := (result < searchlen);    { if buffer <> full no more reads }
  204.       
  205.       Repeat                              { Do a BM search For search String }
  206.         if CaseSensitive then                   { do a Case sensitive search }
  207.           count:=BMSearch(buffer^[bufferpos],result-bufferpos,table,SrchStr)
  208.         else                                  { do a Case insensitive search }
  209.           count:=BMSearchUC(buffer^[bufferpos],result-bufferpos,table,SrchStr);
  210.         
  211.         if count <> $FFFF then begin                   { search String found }
  212.           inc(bufferpos,count);        { starting point of SrchStr in buffer }
  213.           DisplayStr[0] := HexL(abspos+bufferpos) +    { hex and decimal pos }
  214.                            Form('  @######',(abspos+bufferpos) * 1.0);
  215.           if bufferpos > 79 then          { there is a line available beFore }
  216.             Asc2Str(buffer^[bufferpos - 79],DisplayStr[1],79)
  217.           else                          { no line available beFore the found }
  218.             DisplayStr[1] := '';               { position so null the String }
  219.           if (bufferpos + 79) < result then       { at least 79 Chars can be }
  220.             Asc2Str(buffer^[bufferpos],DisplayStr[2],79)         { displayed }
  221.           else                         { only display what is left in buffer }
  222.             Asc2Str(buffer^[bufferpos],DisplayStr[2],result - bufferpos);
  223.           if (bufferpos + 158) < result then    { display the line following }
  224.             Asc2Str(buffer^[bufferpos + 79],DisplayStr[3],79)
  225.           else                          { no line following the found String }
  226.             DisplayStr[3] := '';                { so null the display String }
  227.           Writeln;
  228.           Writeln(DisplayStr[0],'   ',Filename);{ display the File locations }
  229.           
  230.           For x := 1 to 3 do begin
  231.             For y := 1 to length(DisplayStr[x]) do{ filter out non-printables}
  232.               if ord(DisplayStr[x][y]) < 32 then DisplayStr[x][y] := '.';
  233.             if length(DisplayStr[x]) <> 0 then   { only display Strings With }
  234.                Writeln(DisplayStr[x]);                       { valid content }
  235.           end; { For x }
  236.           
  237.           inc(bufferpos,Slen);         { no need to check buffer in found st }
  238.         end;  { if count <> $ffff }
  239.         
  240.       Until (bufferpos >= (result-length(SrchStr))) or (count = $ffff);
  241.       
  242.       if not finished then begin       { Fill 'er up again For another round }
  243.         inc(abspos,result - Slen);      { create overlap so no String missed }
  244.         {$I-} seek(f,abspos);
  245.         BlockRead(f,buffer^,searchlen,result); {$I+}
  246.         if Ioresult <> 0 then begin
  247.           CloseFile;
  248.           ReportError(13);
  249.         end;
  250.       end; { if not finished}
  251.     Until finished;
  252.     dispose(buffer);
  253.   end; { SearchFile }
  254.  
  255. Procedure SearchForFiles;
  256.   Var
  257.     dirinfo : SearchRec;
  258.     FullName: PathStr;
  259.     DirName : DirStr;
  260.     FName   : NameStr;
  261.     ExtName : ExtStr;
  262.     found   : Boolean;
  263.   begin
  264.     FindFirst(Filename,AnyFile,dirinfo);
  265.     found := DosError = 0;
  266.     if not found then begin
  267.       Writeln('Cannot find ',Filename);
  268.       ReportError(255);
  269.     end;
  270.     FSplit(Filename,DirName,FName,ExtName);
  271.     While found do begin
  272.       if (dirinfo.Attr and 24) = 0 then begin
  273.         FullName := DirName + dirinfo.name;
  274.         if OpenFile(FullName) then begin
  275.           SearchFile(FullName);
  276.           CloseFile;
  277.         end;
  278.       end;
  279.       FindNext(dirinfo);
  280.       found := DosError = 0;
  281.     end;
  282.   end; { SearchForFiles }
  283.  
  284. begin { main}
  285.   (**) StartTimer;
  286.   Writeln(copyright1);
  287.   Writeln(copyright2);
  288.   ParseCommandLine;
  289.   SearchForFiles;
  290.   (**) WriteElapsedTime;
  291. end.
  292.  
  293.